home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / PARTFUNC.PRG < prev    next >
Encoding:
Text File  |  1993-11-08  |  7.7 KB  |  347 lines
  1. *    Last change:  MIB   8 Nov 93    3:36 pm
  2.  
  3. procedure PARTEDIT
  4. *       P A R T E D I T
  5. *       Routine to process Parts Records
  6. parameters TOP, LEFT, NROWS, MODE
  7. * do PARTEDIT with TOP, LEFT, NROWS, MODE
  8. private PARTFUNC, OLDSCR, WIDTH
  9.  
  10. save screen to OLDSCR
  11. PARTFUNC = "PARTUPDAT"
  12. WIDTH = 38
  13. PARTPICS[1] = replicate("X",24)
  14. MPARTSPEC = "P"
  15. select PARTLINE
  16.  
  17. MADD = (reccount()=0)
  18. go top
  19. do while .not. GETOUT
  20.     do PARTPRMT
  21.     DBEDIT(TOP,LEFT,TOP+NROWS-2,LEFT+WIDTH-1,PARTFLDS,PARTFUNC,PARTPICS,PARTHDRS,chr(196),chr(179),.t.,"")
  22. enddo
  23. set color to (COLNORM)
  24. set deleted off
  25. replace PLINENO with recno() all
  26. set deleted on
  27. GETOUT = .f.
  28. do PGETSPEC
  29. restore screen from OLDSCR
  30. return
  31.  
  32. *********************************************************************
  33.  
  34. function PARTUPDAT
  35. parameters MODE, FLD_PTR
  36. private SCRBOT, RETVAL, ROWNO, COLNO
  37. rowno = row()
  38. colno = col()
  39. SCRBOT = ""
  40. ADDREC = .f.
  41. QBKEY = lastkey()
  42. RETVAL = 1
  43.  
  44. do case
  45. case QBKEY=27
  46.     QBRESP = "Q"
  47. case MODE=3 .or. MODE=2                && Empty, past bottom
  48.     MPLINENO = PARTLINE->PLINENO + 1
  49.     MADD = .t.
  50.     keyboard replicate(chr(19),FLD_PTR-1)
  51.     return 3
  52. case MODE<4
  53.     return 1
  54. *case QBKEY=-2                      && F3
  55. *    replace PARTSPEC with "S"
  56. *    QBRESP="I"
  57. *case QBKEY=-3                      && F4
  58. *    replace PARTSPEC with "P"
  59. *    QBRESP="I"
  60. case QBKEY=13
  61.     save screen
  62.     CURFLD = PARTFLDS[FLD_PTR]
  63.     MEDSTR = PARTLINE->&CURFLD
  64.     set color to (COLFLASH)
  65.     @ ROWNO, COLNO say MEDSTR picture PARTPICS[FLD_PTR]
  66.     QBRESP = iif(QBYESNO("Edit this Field?")="Y","E","I")
  67.     set color to (COLBRIGHT)
  68.     restore screen
  69. case QBKEY=-9            && F10
  70. *    ACTION = QBPROMPT("Ignore|Edit|Add|Delete|Restore all|Parts "+chr(29)+" Specialist|Quit|","",6)
  71.     ACTION = QBPROMPT("Ignore|Edit|Delete|Restore all|Quit|","",6)
  72. otherwise
  73.     QBRESP = "E"
  74.     keyboard chr(QBKEY)
  75. endcase
  76.  
  77. set color to (COLBRIGHT)
  78.  
  79. DO CASE
  80. *CASE QBRESP="A"     && Add one
  81. *    RETVAL = 3
  82. case QBRESP="D"
  83.     save screen
  84.     CURFLD = PARTFLDS[FLD_PTR]
  85.     MEDSTR = PARTLINE->&CURFLD
  86.     set color to (COLFLASH)
  87.     @ ROWNO, COLNO say MEDSTR picture PARTPICS[FLD_PTR]
  88.     if QBYESNO("Delete this line?")="Y"
  89.         delete
  90.     endif
  91.     set color to (COLBRIGHT)
  92.     restore screen
  93.     skip 1
  94.     skip -1
  95.     keyboard chr(19)+chr(24)
  96.     RETVAL = 2
  97. case QBRESP="E"     && Normal Selection by CR
  98.     do PARTGET with RETVAL,ROWNO,COLNO, FLD_PTR
  99.     QBRESP = iif(GETOUT,"Q"," ")
  100. *case QBRESP="P"
  101. *    if MPARTSPEC="P"
  102. *        MPARTSPEC = "S"
  103. *        do QBMESS with "Now Entering Specialist Materials",COLFLASH,5
  104. *    else
  105. *        MPARTSPEC = "P"
  106. *        do QBMESS with "Now Entering Parts",COLFLASH,5
  107. *    endif
  108. case QBRESP="R"
  109.     if QBYESNO("Restore all deleted lines?")="Y"
  110.         set deleted off
  111.         recall all for deleted()
  112.         go top
  113.         set color to (COLBRIGHT)
  114.         RETVAL = 2
  115.         set deleted on
  116.     endif
  117. otherwise
  118.     GETOUT = .f.
  119. ENDCASE
  120.  
  121. if QBRESP="Q"
  122.     GETOUT = (QBYESNO("Finished editing Parts?")="Y")
  123.     MADD = .f.
  124. endif
  125.  
  126. if .not. GETOUT
  127.     do PARTPRMT
  128.     if FLD_PTR>2
  129.         SCRBOT = replicate(chr(19),3) + iif(MADD,chr(24),"")
  130.     else
  131.         SCRBOT = chr(4)
  132.     endif
  133.     keyboard SCRBOT
  134. endif
  135. set color to (COLBRIGHT)
  136.  
  137. @ 23,1 clear to 23,38
  138.  
  139. return iif(GETOUT,0,RETVAL)
  140.  
  141. *********************************************************************
  142.  
  143. procedure PARTGET
  144. parameters RETVAL, ROWNO, COLNO, FLD_PTR
  145.  
  146. PARTFILL()
  147.  
  148. do case
  149. case FLD_PTR=1
  150.     @ ROWNO, COLNO get MPARTDESC picture "@S24"
  151.     do QBREAD with "Enter Description",""
  152. case FLD_PTR=2
  153.     @ ROWNO, COLNO get MQTY picture "99"
  154.     do QBREAD with "Enter Quantity",""
  155. case FLD_PTR=3
  156.     @ ROWNO, COLNO get MUPRICE picture "9999.99"
  157.     do QBREAD with "Enter Unit Price",""
  158. otherwise
  159.     ?? chr(7)
  160. endcase
  161.  
  162. if .not. GETOUT
  163.     if MPLINENO>reccount()
  164.         append blank
  165.         replace INVNO with MINVNO, PLINENO with MPLINENO, PARTSPEC with MPARTSPEC
  166.         RETVAL = 1
  167.     endif
  168.     do case
  169.     case FLD_PTR=1
  170.         replace PARTDESC with MPARTDESC
  171.     case FLD_PTR=2
  172.         replace QTY with MQTY, TPRICE with UPRICE * QTY
  173.     case FLD_PTR=3
  174.         replace UPRICE with MUPRICE, TPRICE with UPRICE * QTY
  175.     endcase
  176.     if MADD
  177.         MADD = (lastkey()<>3)           && PgDn
  178.     endif
  179. else
  180.     RETVAL = 0
  181. endif
  182.  
  183. return
  184.  
  185. *********************************************************************
  186.  
  187. procedure PARTPRMT
  188. *       PARTPRMT
  189. private M
  190. do QBCLMESS
  191. set color to (COLBRIGHT)
  192. M = "Move with "+chr(24)+" & "+chr(25)+[. Scroll PgUp/PgDn. Exit: ESC. Menu: F10]
  193. @ QBMSGLIN,centre(M,80) SAY M
  194. *M = "Enter Specialist Materials: F3, Parts: F4"
  195. *@ QBMSGLIN+1,centre(M,80) SAY M
  196.  
  197. set color to (COLHEAD)
  198. @ 2,0 say iif(MADD,"Adding ","Editing")
  199. set color to (COLBRIGHT)
  200. return
  201.  
  202. *********************************************************************
  203.  
  204. function PARTLOAD
  205. *   P A R T L O A D
  206. parameters PINVNO
  207. private STATUS, SELNO
  208. STATUS = 0
  209.  
  210. select PARTLINE
  211. zap
  212.  
  213. SELNO = select()
  214. use
  215.  
  216. select PARTS
  217. set softseek off
  218. seek str(PINVNO,5)
  219. if found()
  220.     copy to PARTLINE while PARTS->INVNO=PINVNO
  221.     STATUS = 2
  222. endif
  223. select (SELNO)
  224. use PARTLINE
  225.  
  226. return STATUS
  227.  
  228. *********************************************************************
  229.  
  230. procedure PARTSAVE
  231. parameters PINVNO
  232. private ZAPIT
  233. set deleted off
  234. do PARTDEL with PINVNO
  235.  
  236. *   Copy the records across
  237. select PARTLINE
  238. go top
  239. do while .not. eof()
  240.     PARTFILL()
  241.     if .not. deleted()
  242.         select PARTS
  243.         go top
  244.         if PARTINFO()
  245.             do QBADBLNK with 50
  246.             go top
  247.         endif
  248.         replace PARTS->PARTDESC with MPARTDESC, PARTS->INVNO with MINVNO
  249.         replace PARTS->PARTSPEC with MPARTSPEC, PARTS->QTY with MQTY
  250.         replace PARTS->UPRICE with MUPRICE, TPRICE with MTPRICE, PARTS->PLINENO with MPLINENO
  251.     endif
  252.     select PARTLINE
  253.     skip
  254. enddo
  255. set deleted on
  256. MINVNO = PINVNO
  257.  
  258. return
  259.  
  260. *********************************************************************
  261.  
  262. function PARTFILL
  263.  
  264. if INVNO<>0
  265.     MINVNO = INVNO
  266.     MPLINENO = PLINENO
  267.     MPARTSPEC = PARTSPEC
  268. endif
  269. MPARTDESC = PARTDESC
  270. MTPRICE = TPRICE
  271. MUPRICE = UPRICE
  272. MQTY = QTY
  273.  
  274. return PARTINFO()
  275.  
  276. *********************************************************************
  277.  
  278. function PARTINFO
  279.  
  280. return TPRICE>0 .or. .not. empty(PARTDESC)
  281.  
  282. *********************************************************************
  283.  
  284. function PARTCLEAR
  285.  
  286. MPARTDESC = space(40)
  287. MPARTSPEC = "P"
  288. store 0 to MQTY, MTPRICE, MUPRICE, MPLINENO
  289.  
  290. return 0
  291. *********************************************************************
  292.  
  293. procedure PARTSHOW
  294. *       P A R T S H O W
  295. *       Routine to process Parts Records
  296. parameters TOP, LEFT, NROWS
  297. * do PARTSHOW with TOP, LEFT, NROWS, MODE
  298. private PARTFUNC, OLDSCR, WIDTH
  299.  
  300. PARTFUNC = .t.
  301. WIDTH = 38
  302. PARTPICS[1] = replicate("X",15)
  303.  
  304. select PARTLINE
  305. go top
  306. keyboard chr(27)
  307. set color to (COLBRIGHT)
  308.  
  309. DBEDIT(TOP,LEFT,TOP+NROWS-2,LEFT+WIDTH-1,PARTFLDS,PARTFUNC,PARTPICS,PARTHDRS,chr(196),chr(179),.t.,"")
  310.  
  311. @ 23,1 clear to 23,38
  312.  
  313. set color to (COLNORM)
  314.  
  315. return
  316.  
  317. *********************************************************************
  318.  
  319. procedure PARTDEL
  320. parameters PINVNO
  321.  
  322. *   Get rid of the old stuff
  323. select PARTS
  324.  
  325. set softseek off
  326. seek str(PINVNO,5)
  327. do while .not. eof() .and. PARTS->INVNO=PINVNO
  328.     do QBWIPE
  329.     seek str(PINVNO,5)
  330. enddo
  331.  
  332. return
  333.  
  334. ***********************************************************************
  335.  
  336. procedure PGETSPEC
  337. *       Input value for Paints and Materials
  338. if MINSTOPAY
  339.     @ 8,62 get MINSSPEC picture "9999.99"
  340. else
  341.     @ 8,71 get MOWNSPEC picture "9999.99"
  342. endif
  343. do QBREAD with "Enter Paints and Materials",""
  344. GETOUT = .f.
  345.  
  346. return
  347.